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-- file TypePack.Mesa 

-- last modified by Satterthwaite, June 30, 1978 11:34 AM 

DIRECTORY 

StringDefs: FROM "stringdef s" . 
SymbolTableDefs: FROM "symboltabledef s" , 
SymDefs: FROM "symdefs", 
TypePackDefs: FROM "typepackdefs" ; 

TypePack: PROGRAM IMPORTS StringDefs EXPORTS TypePackDefs - 
BEGIN 
OPEN SymDefs, TypePackDefs; 

-- internal utilities 

HTHandle: TYPE « RECORD[ 
stb: SymbolTableBase, 
hti: HTIndex]; 

Equallds: PROCEDURE [idl, id2: HTHandle] RETURNS [BOOLEAN] - 
BEGIN 

OPEN bl: idl. stb, b2: id2.stb; 
ssl, ss2: StringDefs. SubStringDescriptor; 
IF idl « id2 THEN RETURN [TRUE]; 

bl.SubStringForHash[@ssl, idl. hti]; b2.SubStringForHash[@ss2, id2.hti]; 
RETURN [StringDefs. EqualSubStringsi@ssl. 0ss2]] 
END; 

CTXHandle: TYPE » RECORD[ 
stb: SymbolTableBase, 
ctx: CTXIndex]; 

EqContexts: PROCEDURE [contextl, context2: CTXHandle] RETURNS [BOOLEAN] « 
BEGIN 

OPEN bl: contextl. stb, b2: context2. stb; 
ctxl, ctx2: CTXIndex; 
mdil, mdi2: MDIndex; 

IF contextl = context2 THEN RETURN [TRUE]; 
IF contextl. stb = context2.stb THEN RETURN [FALSE]; 
IF LOOPHOLE[contextl.ctx, CARDINAL] <= 5*SIZE[simpl e CTXRecord] 

THEN RETURN [contextl . ctx « context2 . ctx] ; -- predefined types 
WITH cl: (bl.ctxb+contextl.ctx) SELECT FROM 
simple => 

BEGIN mdil <- OwnMdi; ctxl ^ contextl. ctx; 
END; 
included «> 

BEGIN mdil ♦- cl.ctxmodule; ctxl *- cl.ctxmap; 
END; 
ENDCASE «> ERROR; 
WITH c2: (b2.ctxb+context2.ctx) SELECT FROM 
simple «> 

BEGIN mdi2 *- OwnMdi; ctx2 ♦- context2.ctx; 
END; 
included »> 

BEGIN mdi2 ^ c2 . ctxmodule; ctx2 *- c2.ctxmap; 
END; 
ENDCASE «> ERROR; 
RETURN [ctxl - Ctx2 
AND Equallds[ 

[contextl .stb, (bl .mdb+mdil) .mdhti], 
[context2.stb, (b2 .mdb+mdi2) .mdhti]] 
AND 

((bl .mdb+mdil) .mdStamp. zapped OR (b2 .mdb+mdi2) .mdStamp .zapped 
OR (bl. mdb+mdil) .mdStamp « (b2 .mdb+mdi2) .mdStamp)] 
END; 

-- type relations 

EquivalentTypes: PUBLIC PROCEDURE [typel, type2: TypeHandle] RETURNS [BOOLEAN] 
BEGIN 

OPEN bl: typel. stb, b2: type2.stb; 
IF typel « typ82 OR typel. sei « typeANY OR type2.sei » typeANY 

THEN RETURN [TRUE]; 
IF typel. sei « SENull OR type2.sei - SENull 
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THEN RETURN [typel.sei - typeZ.sei]; 
RETURN [WITH tl: (bl .seb+typel. sei ) SELECT FROM 
basic ■> 

WITH t2: (b2.seb+type2.s0i) SELECT FROM 
basic °> tl.code ° t2.cocl0, 
ENDCASE -> FALSE, 
enumerated ■> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
enumerated «> 

EqContexts[[typel.stb, tl . valuectx] , [type2.stb, t2.va1uectx]], 
ENDCASE ■> FALSE, 
record «•> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
record ■> 

EqContexts[Ctypel.stb, tl .f ieldctx] , [type2.stb, t2.f ieldctx]], 
ENDCASE ■> FALSE, 
pointer «> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
pointer ■> 

(tl. ordered « t2. ordered) 
AND EquivalentTypes[ 

[typel.stb, bl.UnderType[tl .pointed to type]], 
[type2.stb, b2.UnderType[t2 .pointedtotype]]], 
ENDCASE -> FALSE, 
array «> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
array => 

tl. packed = t2. packed 
AND EquivalentTypes[ 

[typel.stb, bl.UnderType[tl .component type]]. 
[type2.stb, b2.UnderType[t2 .component type]]] 
AND Equiva1entTypes[ 

[typel.stb, bl .UnderType[tl . index type]]. 
[type2.stb, b2.UnderType[t2. index type]]], 
ENDCASE «> FALSE, 
arraydesc «> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
arraydesc »> 

Equiva1entTypes[ 

[typel.stb, bl. Under Type[tl. described Type]]. 
[type2.stb, b2 .UnderType[t2 .describedType]]] , 
ENDCASE »> FALSE, 
transfer **^ 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
transfer ■> 

tl.mode » t2.mode 
AND EquivalentArgs[ 

[typel.stb, tl. inrecord], 
[type2.stb, t2. inrecord]] 
AND EquivalentArgs[ 

[typel.stb, tl.outrecord], 
[type2.stb, t2 .outrecord]], 
ENDCASE «> FALSE, 
relative «> 

WITH t2; (b2.seb+type2.sei) SELECT FROM 
relative «> 

EquivalentTypes[ 

[typel . stb, bl . Under Type[tl .baseType]], 
[type2.stb, b2.UnderType[t2 .baseType]]] 
AND EquivalentTypes[ 

[typel .stb, bl.UnderType[tl .off setType]], 
[type2.stb, b2.UnderType[t2 .off setType]]] , 
ENDCASE «> FALSE, 
subrange «> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
subrange «> 

EquivalentTypes[ 

[typel.stb, bl .UnderType[tl , range type]], 
[type2.stb, b2 .UnderType[t2 . range type]]] 
AND 
(-tl. filled OR ~t2. filled 

OR (tl. origin » t2. origin AND tl. empty ■ t2. empty 
AND (tl. empty OR tl. range - t2. range))), 
ENDCASE -> FALSE, 
long «> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
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long -> 

Equiva1entTypes[ 

[typel.stb, bl.UnderType[tl .range type]], 
[type2.stb, b2.UnderType[t2. range type]]], 
ENDCASE ■> FALSE, 
real ■> 

WITH t2: (b2.seb+type2.sei) SELECT FROM 
real -> TRUE, 
ENDCASE -> FALSE, 
ENDCASE «> FALSE] 
END; 

ArgHandle: TYPE ■ RECORD[ 
stb: SymbolTableBase, 
sei: recordCSEIndex]; 

EquivalentArgs: PROCEDURE [argl. arg2: ArgHandle] RETURNS [BOOLEAN] ■ 
BEGIN 

OPEN bl: argl. stb, b2: arg2.stb; 
seil, sei2: ISEIndex; 
checkids: BOOLEAN; 
IF argl. sei » SENull OR arg2.sei » SENull 

THEN RETURN [argl. sei » arg2.sei]; 
checkids ♦- ~(bl . seb+argl. sei) .unif ield AND ~(b2.seb+arg2. sei) .unif ield; 
seil ^ bl.FirstCtxSe[{bl.seb+argl.sei) .f ieldctx]; 
sei2 ♦- b2. FirstCtxSe[(b2.seb+arg2. sei) .f ieldctx]; 
UNTIL seil - SENull OR sei2 « SENull 
DO 
IF '-EquivalentTypesC 

[argl. stb, bl .UnderType[(bl . seb+seil) . idtype]], 
[arg2.stb. b2.UnderType[(b2 . seb+sei2) . idtype]]] 
OR Tcheckids 

AND (bl. seb+seil). htptr # HTNull 
AND (b2.seb+sei2). htptr # HTNull 
AND -EqualldsC 

[argl. stb, (bl .seb+seil) .htptr], 
[arg2.stb, (b2. seb+sei2) .htptr]]) 
THEN RETURN [FALSE]; 
seil *- bl.NextSe[seil]; sei2 <- b2.NextSe[sei2]; 
ENDLOOP; 
RETURN [seil - sei2] 
END; 

AssignableTypes: PUBLIC PROCEDURE [typeL, typeR: TypeHandle] RETURNS [BOOLEAN] 
BEGIN 

OPEN bL: typeL. stb, bR: typeR. stb; 
IF typeL « typeR OR typeL. sei - typeANY OR typeR. sei « typeANY 

THEN RETURN [TRUE]; 
IF typeL. sei = SENull OR typeR. sei « SENull 

THEN RETURN [typeL. sei « typeR. sei]; 
RETURN [WITH tL: (bL. seb+typeL. sei) SELECT FROM 
record »> 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
record »> 

EqContexts[[typeL.stb, tL.f ieldctx] , [typeR. stb. tR.f ieldctx]] 
OR 
(WITH tR SELECT FROM 

linked «> AssignableTypes[ 
typeL, 

[typeR. stb, bR.UnderType[l ink type]]] , 
ENDCASE => FALSE), 
ENDCASE «> FALSE, 
pointer «> 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
pointer »> 

(~tL. ordered OR tR. ordered) 
AND AssignableTypes[ 

[typeL. stb, bL. Under Type[ tL . pointed to type]], 
[typeR. stb, bR. Under Type[tR.po in ted totype]]]. 
ENDCASE -> FALSE, 
arraydesc -> 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
arraydesc «> 
CommonTypes[ 
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[typeL.stb, bL.UnclerType[tL.d0ScribeclType]], 
[typeR.stb, bR.UnderType[tR.describ8dType]]], 
ENDCASE ■> FALSE, 
transfer ■> 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
transfer ■> 

(tL.mode ■ tR.mode OR (tL.mode » error AND tR.mode ■ signal)) 
AND Equiva1entArgs[ 

[typeL.stb, tL. inrecord], 
[typeR.stb, tR. inrecord]] 
AND EquivalentArgs[ 

[typeL.stb, tL.outrecord], 
[typeR.stb, tR.outrecord]] , 
ENDCASE -> FALSE, 
relative ■> 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
relative ■> 

EquivalentTypes[ 

[typeL.stb, bL.UnderType[tL.baseType]] , 
[typeR.stb, bR.UnderTypeftR.baseType]]] 
AND AssignableTypes[ 

FullRangeType[[ typeL.stb, bL.UnderType[tL.off setType]]] , 
Full RangeType[[ typeR.stb, bR. UnderType[tR. off setType]]]] , 
ENDCASE -> FALSE, 
subrange »> CoveringType[typeL, typeR], 
long «> 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
long »> 
AssignableTypes[ 

[typeL.stb, bL.UnderType[tL. range type]] , 
[typeR. stb, bR.UnderType[tR . range type]]], 
ENDCASE «> FALSE, 
ENDCASE «> EquivalentTypes[typeL, typeR]] 
END; 



CommonTypes: PROCEDURE [typeL, typeR: TypeHandle] RETURNS [BOOLEAN] « 
BEGIN 

OPEN bL: typeL.stb, bR: typeR.stb; 
IF typeL « typeR OR typeL. sei « typeANY OR typeR. sei » typeANY 

THEN RETURN [TRUE]; 
RETURN [WITH tL: (bL. seb+typeL. sei ) SELECT FROM 
array => 

WITH tR: (bR.seb+typeR.sei) SELECT FROM 
array => 

tL. packed = tR. packed 
AND EquivalentTypes[ 

[typeL.stb, bL.UnderType[tL. component type]], 
[typeR.stb, bR.UnderType[tR. component type]]] 
AND CoveringType[ 

[typeL.stb, bL.UnderType[tL. index type]], 
[typeR.stb, bR.UnderType[tR. indextype]]], 
ENDCASE => FALSE. 
ENDCASE => EquivalentTypes[typeL, typeR]] 
END; 

CoveringType: PROCEDURE [typel, type2: TypeHandle] RETURNS [BOOLEAN] » 
BEGIN 

OPEN bl: typel. stb, b2: type2.stb; 
RETURN [WITH t2: (b2. seb+type2 .sei ) SELECT FROM 
subrange => 

WITH tl: (bl.seb+typel.sei) SELECT FROM 
subrange «> 

IF ~tl. filled OR ~t2. filled OR t2. empty 
OR (tl. origin » t2. origin AND tl. range >■ t2. range) 
THEN CoveringType[ 

[typel. stb, bl.UnderType[tl .range type]] , 
type2] 
ELSE FALSE. 
ENDCASE -> 
CoveringType[ 
typel. 

[type2.stb, b2 .Under Type[t2 .range type]]], 
ENDCASE «> EquivalentTypes[typel, type2]] 
END; 
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FuHRangeType: PROCEDURE [type: TypeHandle] RETURNS [TypeHandle] 
BEGIN 

OPEN b: type.stb; 
sei: CSEIndex; 
sei +• type. sei ; 
DO 
WITH (b.seb+sei) SELECT FROM 

subrange -> sei ♦- b.UnderType[rangetype]; 
ENDCASE ■> EXIT; 
ENDLOOP; 
RETURN [[type.stb, sei]] 
END; 

END. 



